home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / update.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  5KB  |  159 lines
  1. /* update.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  26.         sfactr;
  27.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  28.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  29. } status_;
  30.  
  31. #define status_1 status_
  32.  
  33. struct {
  34.     doublereal value[200000];
  35. } blank_;
  36.  
  37. #define blank_1 blank_
  38.  
  39. /*<       subroutine update(vinit,loct,node1,node2,nupda,icheck) >*/
  40. /* Subroutine */ int update_(vinit, loct, node1, node2, nupda, icheck)
  41. doublereal *vinit;
  42. integer *loct, *node1, *node2, *nupda, *icheck;
  43. {
  44.     /* System generated locals */
  45.     doublereal d_1, d_2;
  46.  
  47.     /* Builtin functions */
  48.     double d_sign();
  49.  
  50.     /* Local variables */
  51.     static doublereal delv, vlim, vnew;
  52.     extern /* Subroutine */ int copy8_();
  53.     static doublereal xfact;
  54. #define nodplc ((integer *)&blank_1)
  55. #define cvalue ((complex *)&blank_1)
  56.  
  57. /*<       implicit double precision (a-h,o-z) >*/
  58.  
  59. /*     this routine updates and limits the controlling variables for the 
  60. */
  61. /* nonlinear controlled sources. */
  62.  
  63. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  64. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  65. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  66. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  67. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  68. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  69. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  70. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  71. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  72. /* spice version 2g.6  sccsid=status 3/15/83 */
  73. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  74. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  75. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  76. /* spice version 2g.6  sccsid=blank 3/15/83 */
  77. /*<       common /blank/ value(200000) >*/
  78. /*<       integer nodplc(64) >*/
  79. /*<       complex cvalue(32) >*/
  80. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  81.  
  82.  
  83. /*<       go to (40,10,40,20,30,50), initf >*/
  84.     switch (status_1.initf) {
  85.     case 1:  goto L40;
  86.     case 2:  goto L10;
  87.     case 3:  goto L40;
  88.     case 4:  goto L20;
  89.     case 5:  goto L30;
  90.     case 6:  goto L50;
  91.     }
  92. /*<    10 vnew=vinit >*/
  93. L10:
  94.     vnew = *vinit;
  95. /*<       go to 70 >*/
  96.     goto L70;
  97. /*<    20 vnew=value(lx0+loct) >*/
  98. L20:
  99.     vnew = blank_1.value[tabinf_1.lx0 + *loct - 1];
  100. /*<       go to 70 >*/
  101.     goto L70;
  102. /*<    30 vnew=value(lx1+loct) >*/
  103. L30:
  104.     vnew = blank_1.value[tabinf_1.lx1 + *loct - 1];
  105. /*<       go to 70 >*/
  106.     goto L70;
  107. /*<    40 vnew=value(lvnim1+node1)-value(lvnim1+node2) >*/
  108. L40:
  109.     vnew = blank_1.value[tabinf_1.lvnim1 + *node1 - 1] - blank_1.value[
  110.         tabinf_1.lvnim1 + *node2 - 1];
  111. /*<       go to 60 >*/
  112.     goto L60;
  113. /*<    50 call copy8(value(lx1+loct),value(lx0+loct),nupda) >*/
  114. L50:
  115.     copy8_(&blank_1.value[tabinf_1.lx1 + *loct - 1], &blank_1.value[
  116.         tabinf_1.lx0 + *loct - 1], nupda);
  117. /*<       xfact=delta/delold(2) >*/
  118.     xfact = status_1.delta / status_1.delold[1];
  119. /*<       vnew=(1.0d0+xfact)*value(lx1+loct)-xfact*value(lx2+loct) >*/
  120.     vnew = (xfact + 1.) * blank_1.value[tabinf_1.lx1 + *loct - 1] - xfact * 
  121.         blank_1.value[tabinf_1.lx2 + *loct - 1];
  122. /*<    60 if (dabs(vnew).le.1.0d0) go to 80 >*/
  123. L60:
  124.     if (abs(vnew) <= 1.) {
  125.     goto L80;
  126.     }
  127. /*<       delv=vnew-value(lx0+loct) >*/
  128.     delv = vnew - blank_1.value[tabinf_1.lx0 + *loct - 1];
  129. /*<       if (dabs(delv).le.0.1d0) go to 80 >*/
  130.     if (abs(delv) <= .1) {
  131.     goto L80;
  132.     }
  133. /*<       vlim=dmax1(dabs(0.1d0*value(lx0+loct)),0.1d0) >*/
  134. /* Computing MAX */
  135.     d_2 = (d_1 = blank_1.value[tabinf_1.lx0 + *loct - 1] * .1, abs(d_1));
  136.     vlim = max(.1,d_2);
  137. /*<       vnew=value(lx0+loct)+dsign(dmin1(dabs(delv),vlim),delv) >*/
  138. /* Computing MAX */
  139.     d_2 = abs(delv);
  140.     d_1 = min(vlim,d_2);
  141.     vnew = blank_1.value[tabinf_1.lx0 + *loct - 1] + d_sign(&d_1, &delv);
  142. /*<       go to 70 >*/
  143.     goto L70;
  144. /*<    70 icheck=1 >*/
  145. L70:
  146.     *icheck = 1;
  147. /*<    80 value(lx0+loct)=vnew >*/
  148. L80:
  149.     blank_1.value[tabinf_1.lx0 + *loct - 1] = vnew;
  150. /*<       return >*/
  151.     return 0;
  152. /*<       end >*/
  153. } /* update_ */
  154.  
  155. #undef cvalue
  156. #undef nodplc
  157.  
  158.  
  159.